home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / util / boot / getpassword.lha / getpassword.Amos / getpassword.amosSourceCode
AMOS Source Code  |  1999-01-27  |  3KB  |  162 lines
  1. ' Getpassword original program by THY
  2. ' Anyone can fully modify/enhance this program, no copyright, no charge
  3. ' or credit is asked.
  4. '
  5. Break Off 
  6. Hide 
  7. Get Rom Fonts 
  8. '
  9. ' Two screens for double-buffering 
  10. '
  11. Screen Open 1,320,250,2,0
  12. Curs Off 
  13. Palette 0,$F0,$70
  14. Cls 
  15. Screen Open 0,320,250,2,0
  16. Curs Off 
  17. Palette 0,$F0,$70
  18. Paper 0 : Pen 1
  19. Cls 
  20. '
  21. ' Read "?" coordinates, then precalc rotation  
  22. '
  23. Degree 
  24. Dim X(18),Y(18),Z(18)
  25. Dim XA(18,36),YA(18,36)
  26. For I=1 To 18
  27.    Read X,Y
  28.    Z(I)=0
  29.    X(I)=X
  30.    Y(I)=-Y
  31. Next 
  32. For J=1 To 36
  33.    A=J*10
  34.    For I=1 To 18
  35.       XA(I,J)=160+X(I)*Sin(A)
  36.       YA(I,J)=100+Y(I)
  37.    Next 
  38. Next 
  39. Set Font 1
  40. '
  41. ' Checks for a password and load it in CDE$ (code) 
  42. '
  43. CDE$=""
  44. If Exist("Sys:prefs/getpassword")
  45.    Open In 1,"Sys:Prefs/getpassword"
  46.    L=Min(Lof(1),255)
  47.    X$=Input$(1,L)
  48.    I=1
  49.    While Mid$(X$,I,1)>=" "
  50.       CDE$=CDE$+Mid$(X$,I,1)
  51.       Inc I
  52.    Wend 
  53.    Close 1
  54. End If 
  55. TST$=Chr$(1)
  56. '
  57. ' Loops while password is incorrect
  58. '
  59. A$=""
  60. While TST$<>CDE$
  61.    Gosub HANKEY
  62.    Screen Copy 1,0,0,320,250 To 0,0,0
  63.    I$=Inkey$
  64.    If I$<>""
  65.       If I$<>Chr$(13)
  66.          A$=A$+I$
  67.       Else 
  68.          TST$=A$
  69.          If TST$<>CDE$
  70.             For CLI=1 To 10
  71.                T=Timer
  72.                While Timer-T<15
  73.                   Gosub HANKEY
  74.                   Text 70,150,"     Access denied"
  75.                   Screen Copy 1,0,0,320,250 To 0,0,0
  76.                Wend 
  77.                T=Timer
  78.                While Timer-T<15
  79.                   Gosub HANKEY
  80.                   Screen Copy 1,0,0,320,250 To 0,0,0
  81.                Wend 
  82.             Next 
  83.          End If 
  84.          A$=""
  85.       End If 
  86.    End If 
  87. Wend 
  88. T=Timer
  89. While Timer-T<50
  90.    Gosub HANKEY
  91.    Text 70,150,"    ACCESS GRANTED"
  92.    Screen Copy 1,0,0,320,250 To 0,0,0
  93. Wend 
  94. T=Timer
  95. Screen 0
  96. Fade 3
  97. While Timer-T<50
  98.    Gosub HANKEY
  99.    Text 70,150,"    ACCESS GRANTED"
  100.    Screen Copy 1,0,0,320,250 To 0,0,0
  101. Wend 
  102. End 
  103. '
  104. ' Displays the "?" 
  105. '  
  106. ' Why that stupid subroutine name ?  
  107. ' Because I was looking a Southpark cartoon while coding this !
  108. '
  109. '
  110. '''''''
  111. HANKEY:
  112. '''''''
  113. Add J,1,1 To 36
  114. Screen 1
  115. Cls 0
  116. Text 70,100,"Please Enter Access Code"
  117. Plot XA(1,J),YA(1,J)
  118. For I=2 To 14
  119.    Draw To XA(I,J),YA(I,J)
  120. Next 
  121. Draw To XA(1,J),YA(1,J)
  122. Plot XA(15,J),YA(15,J)
  123. For I=16 To 18
  124.    Draw To XA(I,J),YA(I,J)
  125. Next 
  126. Draw To XA(15,J),YA(15,J)
  127. Multi Wait 
  128. '
  129. ' Amos has been sent to back ? Come back to front please ! 
  130. '
  131. If Not Amos Here
  132.    Amos To Front 
  133. End If 
  134. Multi Wait 
  135. Return 
  136. '
  137. ' Two vector objects...
  138. '
  139. '
  140. ' "?" coordinates
  141. '
  142. Data -50,40
  143. Data -50,60
  144. Data -30,80
  145. Data 30,80
  146. Data 50,60
  147. Data 50,20
  148. Data 10,-20
  149. Data 10,-60
  150. Data -10,-60
  151. Data -10,-20
  152. Data 30,20
  153. Data 30,60
  154. Data -30,60
  155. Data -30,40
  156. '
  157. ' "." coords 
  158. '
  159. Data -10,-100
  160. Data -10,-80
  161. Data 10,-80
  162. Data 10,-100